home *** CD-ROM | disk | FTP | other *** search
/ Young Minds / Young Minds Interactive CD-ROM.ISO / dungeon / demons.f < prev    next >
Encoding:
Text File  |  1987-09-16  |  9.1 KB  |  455 lines
  1. C FIGHTD- INTERMOVE FIGHT DEMON
  2. C
  3. C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  4. C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  5. C WRITTEN BY R. M. SUPNIK
  6. C
  7. C DECLARATIONS
  8. C
  9.     SUBROUTINE FIGHTD
  10.     IMPLICIT INTEGER (A-Z)
  11.     LOGICAL PROB,OAPPLI
  12. #include "parser.h"
  13. #include "gamestate.h"
  14. #include "objects.h"
  15. #include "oflags.h"
  16. #include "oindex.h"
  17. #include "villians.h"
  18. #include "advers.h"
  19. #include "verbs.h"
  20. #include "flags.h"
  21. C
  22.     LOGICAL F
  23. C
  24. C FUNCTIONS AND DATA
  25. C
  26.     DATA ROUT/1/
  27. C FIGHTD, PAGE 2
  28. C
  29.     DO 2400 I=1,VLNT
  30. C                        !LOOP THRU VILLAINS.
  31.       VOPPS(I)=0
  32. C                        !CLEAR OPPONENT SLOT.
  33.       OBJ=VILLNS(I)
  34. C                        !GET OBJECT NO.
  35.       RA=OACTIO(OBJ)
  36. C                        !GET HIS ACTION.
  37.       IF(HERE.NE.OROOM(OBJ)) GO TO 2200
  38. C                        !ADVENTURER STILL HERE?
  39.       IF((OBJ.EQ.THIEF).AND.THFENF) GO TO 2400
  40. C                        !THIEF ENGROSSED?
  41.       IF(OCAPAC(OBJ).GE.0) GO TO 2050
  42. C                        !YES, VILL AWAKE?
  43.       IF((VPROB(I).EQ.0).OR..NOT.PROB(VPROB(I),VPROB(I)))
  44. &        GO TO 2025
  45.       OCAPAC(OBJ)=IABS(OCAPAC(OBJ))
  46.       VPROB(I)=0
  47.       IF(RA.EQ.0) GO TO 2400
  48. C                        !ANYTHING TO DO?
  49.       PRSA=INXW
  50. C                        !YES, WAKE HIM UP.
  51.       F=OAPPLI(RA,0)
  52.       GO TO 2400
  53. C                        !NOTHING ELSE HAPPENS.
  54. C
  55. 2025      VPROB(I)=VPROB(I)+10
  56. C                        !INCREASE WAKEUP PROB.
  57.       GO TO 2400
  58. C                        !NOTHING ELSE.
  59. C
  60. 2050      IF((and(OFLAG2(OBJ),FITEBT)).EQ.0) GO TO 2100
  61.       VOPPS(I)=OBJ
  62. C                        !FIGHTING, SET UP OPP.
  63.       GO TO 2400
  64. C
  65. 2100      IF(RA.EQ.0) GO TO 2400
  66. C                        !NOT FIGHTING,
  67.       PRSA=FRSTQW
  68. C                        !SET UP PROBABILITY
  69.       IF(.NOT.OAPPLI(RA,0)) GO TO 2400
  70. C                        !OF FIGHTING.
  71.       OFLAG2(OBJ)=or(OFLAG2(OBJ),FITEBT)
  72.       VOPPS(I)=OBJ
  73. C                        !SET UP OPP.
  74.       GO TO 2400
  75. C
  76. 2200      IF((and(OFLAG2(OBJ),FITEBT).EQ.0).OR.(RA.EQ.0))
  77. &        GO TO 2300
  78.       PRSA=FIGHTW
  79. C                        !HAVE A FIGHT.
  80.       F=OAPPLI(RA,0)
  81. 2300      IF(OBJ.EQ.THIEF) THFENF=.FALSE.
  82. C                        !TURN OFF ENGROSSED.
  83.       AFLAG(PLAYER)=and(AFLAG(PLAYER), not(ASTAG))
  84.       OFLAG2(OBJ)=and(OFLAG2(OBJ), not(STAGBT+FITEBT))
  85.       IF((OCAPAC(OBJ).GE.0).OR.(RA.EQ.0))
  86. &        GO TO 2400
  87.       PRSA=INXW
  88. C                        !WAKE HIM UP.
  89.       F=OAPPLI(RA,0)
  90.       OCAPAC(OBJ)=IABS(OCAPAC(OBJ))
  91. 2400    CONTINUE
  92. C FIGHTD, PAGE 3
  93. C
  94. C NOW DO ACTUAL COUNTERBLOWS.
  95. C
  96.     OUT=0
  97. C                        !ASSUME HERO OK.
  98. 2600    DO 2700 I=1,VLNT
  99. C                        !LOOP THRU OPPS.
  100.       J=VOPPS(I)
  101.       IF(J.EQ.0) GO TO 2700
  102. C                        !SLOT EMPTY?
  103.       PRSCON=1
  104. C                        !STOP CMD STREAM.
  105.       RA=OACTIO(J)
  106.       IF(RA.EQ.0) GO TO 2650
  107. C                        !VILLAIN ACTION?
  108.       PRSA=FIGHTW
  109. C                        !SEE IF
  110.       IF(OAPPLI(RA,0)) GO TO 2700
  111. C                        !SPECIAL ACTION.
  112. 2650      RES=BLOW(PLAYER,J,VMELEE(I),.FALSE.,OUT)
  113. C                        !STRIKE BLOW.
  114.       IF(RES.LT.0) RETURN
  115. C                        !IF HERO DEAD, EXIT.
  116.       IF(RES.EQ.ROUT) OUT=2+RND(3)
  117. C                        !IF HERO OUT, SET FLG.
  118. 2700    CONTINUE
  119.     OUT=OUT-1
  120. C                        !DECREMENT OUT COUNT.
  121.     IF(OUT.GT.0) GO TO 2600
  122. C                        !IF STILL OUT, GO AGAIN.
  123.     RETURN
  124. C
  125.     END
  126. C BLOW- STRIKE BLOW
  127. C
  128. C DECLARATIONS
  129. C
  130.     INTEGER FUNCTION BLOW(H,V,RMK,HFLG,OUT)
  131.     IMPLICIT INTEGER (A-Z)
  132.     LOGICAL HFLG,OAPPLI,PROB
  133.     INTEGER DEF1R(3),DEF2R(4),DEF3R(5)
  134.     INTEGER RVECTR(66),RSTATE(45)
  135. #include "gamestate.h"
  136. C
  137. C PARSE VECTOR
  138. C
  139.     LOGICAL PRSWON
  140. #include "parser.h"
  141. C
  142. C MISCELLANEOUS VARIABLES
  143. C
  144.     COMMON /STAR/ MBASE,STRBIT
  145. #include "objects.h"
  146. #include "oflags.h"
  147. C
  148. #include "clock.h"
  149.  
  150. #include "advers.h"
  151. #include "verbs.h"
  152. C
  153.     LOGICAL F
  154. C
  155. C FUNCTIONS AND DATA
  156. C
  157.     DATA RMISS/0/,ROUT/1/,RKILL/2/,RLIGHT/3/
  158.     DATA RSER/4/,RSTAG/5/,RLOSE/6/,RHES/7/,RSIT/8/
  159.     DATA DEF1R/1,2,3/
  160.     DATA DEF2R/13,23,24,25/
  161.     DATA DEF3R/35,36,46,47,57/
  162. C
  163.     DATA RVECTR/0,0,0,0,5,5,1,1,2,2,2,2,
  164. &        0,0,0,0,0,5,5,3,3,1,
  165. &        0,0,0,5,5,3,3,3,1,2,2,2,
  166. &        0,0,0,0,0,5,5,3,3,4,4,
  167. &        0,0,0,5,5,3,3,3,4,4,4,
  168. &        0,5,5,3,3,3,3,4,4,4/
  169.     DATA RSTATE/5000,3005,3008,4011,3015,3018,1021,0,0,
  170. &        5022,3027,3030,4033,3037,3040,1043,0,0,
  171. &        4044,2048,4050,4054,5058,4063,4067,3071,1074,
  172. &        4075,1079,4080,4084,4088,4092,4096,4100,1104,
  173. &        4105,2109,4111,4115,4119,4123,4127,3131,3134/
  174. C BLOW, PAGE 3
  175. C
  176.     RA=OACTIO(V)
  177. C                        !GET VILLAIN ACTION,
  178.     DV=ODESC2(V)
  179. C                        !DESCRIPTION.
  180.     BLOW=RMISS
  181. C                        !ASSUME NO RESULT.
  182. #ifdef debug
  183.     PRINT 10,H,V,RMK,HFLG,OUT
  184. 10    FORMAT(' BLOW 10-- ',3I7,L7,I7)
  185. #endif debug
  186.     IF(.NOT.HFLG) GO TO 1000
  187. C                        !HERO STRIKING BLOW?
  188. C
  189. C HERO IS ATTACKER, VILLAIN IS DEFENDER.
  190. C
  191.     PBLOSE=10
  192. C                        !BAD LK PROB.
  193.     OFLAG2(V)=or(OFLAG2(V),FITEBT)
  194.     IF(and(AFLAG(H),ASTAG).EQ.0) GO TO 100
  195.     CALL RSPEAK(591)
  196. C                        !YES, CANT FIGHT.
  197.     AFLAG(H)=and(AFLAG(H), not(ASTAG))
  198.     RETURN
  199. C
  200. 100    ATT=FIGHTS(H,.TRUE.)
  201. C                        !GET HIS STRENGTH.
  202.     OA=ATT
  203.     DEF=VILSTR(V)
  204. C                        !GET VILL STRENGTH.
  205.     OD=DEF
  206.     DWEAP=0
  207. C                        !ASSUME NO WEAPON.
  208.     DO 200 I=1,OLNT
  209. C                        !SEARCH VILLAIN.
  210.       IF((OCAN(I).EQ.V).AND.(and(OFLAG2(I),WEAPBT).NE.0))
  211. &        DWEAP=I
  212. 200    CONTINUE
  213.     IF(V.EQ.AOBJ(PLAYER)) GO TO 300
  214. C                        !KILLING SELF?
  215.     IF(DEF.NE.0) GO TO 2000
  216. C                        !DEFENDER ALIVE?
  217.     CALL RSPSUB(592,DV)
  218. C                        !VILLAIN DEAD.
  219.     RETURN
  220. C
  221. 300    CALL JIGSUP(593)
  222. C                        !KILLING SELF.
  223.     RETURN
  224. C
  225. C VILLAIN IS ATTACKER, HERO IS DEFENDER.
  226. C
  227. 1000    PBLOSE=50
  228. C                        !BAD LK PROB.
  229.     AFLAG(H)=and(AFLAG(H),not(ASTAG))
  230.     IF(and(OFLAG2(V),STAGBT).EQ.0) GO TO 1200
  231.     OFLAG2(V)=and(OFLAG2(V), not(STAGBT))
  232.     CALL RSPSUB(594,DV)
  233. C                        !DESCRIBE.
  234.     RETURN
  235. C
  236. 1200    ATT=VILSTR(V)
  237. C                        !SET UP ATT, DEF.
  238.     OA=ATT
  239.     DEF=FIGHTS(H,.TRUE.)
  240.     IF(DEF.LE.0) RETURN
  241. C                        !DONT ALLOW DEAD DEF.
  242.     OD=FIGHTS(H,.FALSE.)
  243.     DWEAP=IABS(FWIM(0,WEAPBT,0,0,H,.TRUE.))
  244. C                        !FIND A WEAPON.
  245. C BLOW, PAGE 4
  246. C
  247. C PARTIES ARE NOW EQUIPPED.  DEF CANNOT BE ZERO.
  248. C ATT MUST BE > 0.
  249. C
  250. 2000    CONTINUE
  251. #ifdef debug
  252.     PRINT 2050,ATT,OA,DEF,OD,DWEAP
  253. 2050    FORMAT(' BLOW 2050-- ',5I7)
  254. #endif debug
  255.     IF(DEF.GT.0) GO TO 2100
  256. C                        !DEF ALIVE?
  257.     RES=RKILL
  258.     IF(HFLG) CALL RSPSUB(595,DV)
  259. C                        !DEADER.
  260.     GO TO 3000
  261. C
  262. 2100    IF(DEF-2) 2200,2300,2400
  263. C                        !DEF <2,=2,>2
  264. 2200    ATT=MIN0(ATT,3)
  265. C                        !SCALE ATT.
  266.     TBL=DEF1R(ATT)
  267. C                        !CHOOSE TABLE.
  268.     GO TO 2500
  269. C
  270. 2300    ATT=MIN0(ATT,4)
  271. C                        !SCALE ATT.
  272.     TBL=DEF2R(ATT)
  273. C                        !CHOOSE TABLE.
  274.     GO TO 2500
  275. C
  276. 2400    ATT=ATT-DEF
  277. C                        !SCALE ATT.
  278.     ATT=MIN0(2,MAX0(-2,ATT))+3
  279.     TBL=DEF3R(ATT)
  280. C
  281. 2500    RES=RVECTR(TBL+RND(10))
  282. C                        !GET RESULT.
  283.     IF(OUT.EQ.0) GO TO 2600
  284. C                        !WAS HE OUT?
  285.     IF(RES.EQ.RSTAG) GO TO 2550
  286. C                        !YES, STAG--> HES.
  287.     RES=RSIT
  288. C                        !OTHERWISE, SITTING.
  289.     GO TO 2600
  290. 2550    RES=RHES
  291. 2600    IF((RES.EQ.RSTAG).AND.(DWEAP.NE.0).AND.PROB(25,PBLOSE))
  292. &        RES=RLOSE
  293. C
  294.     MI=RSTATE(((RMK-1)*9)+RES+1)
  295. C                        !CHOOSE TABLE ENTRY.
  296.     IF(MI.EQ.0) GO TO 3000
  297.     I=(MOD(MI,1000)+RND(MI/1000))+MBASE+1
  298.     J=DV
  299.     IF(.NOT.HFLG .AND.(DWEAP.NE.0)) J=ODESC2(DWEAP)
  300. #ifdef debug
  301.     PRINT 2650,RES,MI,I,J,MBASE
  302. 2650    FORMAT(' BLOW 2650-- ',5I7)
  303. #endif debug
  304.     CALL RSPSUB(I,J)
  305. C                        !PRESENT RESULT.
  306. C BLOW, PAGE 5
  307. C
  308. C NOW APPLY RESULT
  309. C
  310. 3000    GO TO (4000,3100,3200,3300,3400,3500,3600,4000,3200),RES+1
  311. C
  312. 3100    IF(HFLG) DEF=-DEF
  313. C                        !UNCONSCIOUS.
  314.     GO TO 4000
  315. C
  316. 3200    DEF=0
  317. C                        !KILLED OR SITTING DUCK.
  318.     GO TO 4000
  319. C
  320. 3300    DEF=MAX0(0,DEF-1)
  321. C                        !LIGHT WOUND.
  322.     GO TO 4000
  323. C
  324. 3400    DEF=MAX0(0,DEF-2)
  325. C                        !SERIOUS WOUND.
  326.     GO TO 4000
  327. C
  328. 3500    IF(HFLG) GO TO 3550
  329. C                        !STAGGERED.
  330.     AFLAG(H)=or(AFLAG(H),ASTAG)
  331.     GO TO 4000
  332. C
  333. 3550    OFLAG2(V)=or(OFLAG2(V),STAGBT)
  334.     GO TO 4000
  335. C
  336. 3600    CALL NEWSTA(DWEAP,0,HERE,0,0)
  337. C                        !LOSE WEAPON.
  338.     DWEAP=0
  339.     IF(HFLG) GO TO 4000
  340. C                        !IF HERO, DONE.
  341.     DWEAP=IABS(FWIM(0,WEAPBT,0,0,H,.TRUE.))
  342. C                        !GET NEW.
  343.     IF(DWEAP.NE.0) CALL RSPSUB(605,ODESC2(DWEAP))
  344. C BLOW, PAGE 6
  345. C
  346. 4000    BLOW=RES
  347. C                        !RETURN RESULT.
  348.     IF(.NOT.HFLG) GO TO 4500
  349. C                        !HERO?
  350.     OCAPAC(V)=DEF
  351. C                        !STORE NEW CAPACITY.
  352.     IF(DEF.NE.0) GO TO 4100
  353. C                        !DEAD?
  354.     OFLAG2(V)=and(OFLAG2(V), not(FITEBT))
  355.     CALL RSPSUB(572,DV)
  356. C                        !HE DIES.
  357.     CALL NEWSTA(V,0,0,0,0)
  358. C                        !MAKE HIM DISAPPEAR.
  359.     IF(RA.EQ.0) RETURN
  360. C                        !IF NX TO DO, EXIT.
  361.     PRSA=DEADXW
  362. C                        !LET HIM KNOW.
  363.     F=OAPPLI(RA,0)
  364.     RETURN
  365. C
  366. 4100    IF((RES.NE.ROUT).OR.(RA.EQ.0)) RETURN
  367.     PRSA=OUTXW
  368. C                        !LET HIM BE OUT.
  369.     F=OAPPLI(RA,0)
  370.     RETURN
  371. C
  372. 4500    ASTREN(H)=-10000
  373. C                        !ASSUME DEAD.
  374.     IF(DEF.NE.0) ASTREN(H)=DEF-OD
  375.     IF(DEF.GE.OD) GO TO 4600
  376.     CTICK(CEVCUR)=30
  377.     CFLAG(CEVCUR)=.TRUE.
  378. 4600    IF(FIGHTS(H,.TRUE.).GT.0) RETURN
  379.     ASTREN(H)=1-FIGHTS(H,.FALSE.)
  380. C                        !HE'S DEAD.
  381.     CALL JIGSUP(596)
  382.     BLOW=-1
  383.     RETURN
  384. C
  385.     END
  386. C SWORDD- SWORD INTERMOVE DEMON
  387. C
  388. C DECLARATIONS
  389. C
  390.     SUBROUTINE SWORDD
  391.     IMPLICIT INTEGER(A-Z)
  392.     LOGICAL INFEST,FINDXT
  393. #include "gamestate.h"
  394. #include "curxt.h"
  395. #include "xsrch.h"
  396. #include "objects.h"
  397. #include "oindex.h"
  398. #include "villians.h"
  399. #include "advers.h"
  400. C SWORDD, PAGE 2
  401. C
  402.     IF(OADV(SWORD).NE.PLAYER) GO TO 500
  403. C                        !HOLDING SWORD?
  404.     NG=2
  405. C                        !ASSUME VILL CLOSE.
  406.     IF(INFEST(HERE)) GO TO 300
  407. C                        !VILL HERE?
  408.     NG=1
  409.     DO 200 I=XMIN,XMAX,XMIN
  410. C                        !NO, SEARCH ROOMS.
  411.       IF(.NOT.FINDXT(I,HERE)) GO TO 200
  412. C                        !ROOM THAT WAY?
  413.       GO TO (50,200,50,50),XTYPE
  414. C                        !SEE IF ROOM AT ALL.
  415. 50      IF(INFEST(XROOM1)) GO TO 300
  416. C                        !CHECK ROOM.
  417. 200    CONTINUE
  418.     NG=0
  419. C                        !NO GLOW.
  420. C
  421. 300    IF(NG.EQ.SWDSTA) RETURN
  422. C                        !ANY STATE CHANGE?
  423.     CALL RSPEAK(NG+495)
  424. C                        !YES, TELL NEW STATE.
  425.     SWDSTA=NG
  426.     RETURN
  427. C
  428. 500    SWDACT=.FALSE.
  429. C                        !DROPPED SWORD,
  430.     RETURN
  431. C                        !DISABLE DEMON.
  432.     END
  433. C INFEST-    SUBROUTINE TO TEST FOR INFESTED ROOM
  434. C
  435. C DECLARATIONS
  436. C
  437.     LOGICAL FUNCTION INFEST(R)
  438.     IMPLICIT INTEGER(A-Z)
  439. C
  440. C ROOMS
  441. #include "rindex.h"
  442. #include "objects.h"
  443. #include "oindex.h"
  444. #include "villians.h"
  445. #include "flags.h"
  446. C
  447.     IF(.NOT.ENDGMF) INFEST=(OROOM(CYCLO).EQ.R).OR.
  448. &        (OROOM(TROLL).EQ.R).OR.
  449. &        ((OROOM(THIEF).EQ.R).AND.THFACT)
  450.     IF(ENDGMF) INFEST=(R.EQ.MRG).OR.(R.EQ.MRGE).OR.
  451. &        (R.EQ.MRGW).OR.
  452. &        ((R.EQ.INMIR).AND.(MLOC.EQ.MRG))
  453.     RETURN
  454.     END
  455.